home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / p4 / p4-1_2b.lha / p4-1.2b / contrib_f / norm_slave.f < prev    next >
Text File  |  1992-10-19  |  3KB  |  100 lines
  1.       subroutine fslave ()
  2.  
  3.       include 'p4f.h'
  4.  
  5. *-----
  6. *  file:- norm_slave.f
  7. *
  8. *  Test program for new p4 fortran library.
  9. *    Receive vector from master,
  10. *    compute sum norm,
  11. *    send result back to master.
  12. *
  13. *  features:-
  14. *    max vector length <= 200   (controlled by `NMAX')
  15. *    4 data byte per integer    (controlled by `LENINT')
  16. *    4 data byte per item       (real; controlled by `LENREAL')
  17. *
  18. *  Debug code disabled by `c$$$'.
  19. *  status:- plain vanilla, no error control
  20. *  Volker Kurz, ANL & U Frankfurt, 03-Oct-91
  21. *-----
  22. *     .. p4 routines ..
  23.       external   p4myid, p4recv, p4send
  24. *
  25. *     .. constants ..
  26.       integer    NMAX,      LENINT,   LENREAL,   OFF,    MASTER
  27.       parameter (NMAX=200 , LENINT=4, LENREAL=4, OFF=-1, MASTER=0)
  28.       integer    TAGCNT,    TAGDAT,    TAGNEW,    TAGEND
  29.       parameter (TAGCNT=10, TAGDAT=20, TAGNEW=30, TAGEND=40)
  30.       real       ZERO
  31.       parameter (ZERO=0.0)
  32. *
  33. *     .. variables and arrays ..
  34.       integer    myid, n, i, itype, iretcd, ireclen, iproc, msglen
  35.       real       v(NMAX), rnorm
  36. *-----
  37.       myid = p4myid()
  38. c$$$      write (*,*) 'slave ', myid, ' ready.'
  39. c$$$      call flush ()
  40. *
  41. *  Outer loop for different matrices
  42. *  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  43.  1    continue
  44. *
  45. *     .. receive vector length ..
  46.       itype = OFF
  47.       iproc = MASTER
  48.       call p4recv (itype, iproc, n, LENINT, ireclen, iretcd)
  49. c$$$      write (*,*) 'retcod from recv = ', iretcd, ' id = ', myid
  50. c$$$      write (*,*) 'ireclen from recv = ', ireclen, ' id = ', myid
  51. c$$$      call flush
  52.       if (itype.eq.TAGEND) then
  53.          write (*,*) 'slave', myid, ' ended normally'
  54.          return
  55.       elseif (itype.ne.TAGCNT) then
  56.          write (*,*)
  57.      $        'slave', myid, ' received unexpected data type:', itype
  58.          return
  59.       endif
  60.  
  61. *  Main loop for calculation
  62. *  ~~~~~~~~~~~~~~~~~~~~~~~~~
  63. *  Receive one vector at a time from 'MASTER'.  
  64. *  Decide upon data type 'itype', whether norm shall be computed
  65. *  or program terminated.
  66. *  Watch out for unknown data type.
  67. *
  68.  2    continue
  69. *        .. receive vector ..
  70.          itype = OFF
  71.          iproc = MASTER
  72.          msglen = n*LENREAL
  73. c$$$         write (*,*) 'recving vec  id = ', myid
  74. c$$$         call flush
  75.          call p4recv (itype, iproc, v, msglen, ireclen, iretcd)
  76. c$$$         write (*,*) 'recvd vec  id = ', myid
  77. c$$$         call flush
  78.          if (itype.eq.TAGDAT) then
  79. *           .. compute norm ..
  80.             rnorm = ZERO
  81.             do 22 i=1,n
  82.                rnorm = rnorm + abs (v(i))
  83.  22         continue 
  84. *           .. send result to host ..
  85.             call p4send (TAGDAT, MASTER, rnorm, LENREAL, iretcd)
  86.          elseif (itype.eq.TAGNEW) then
  87. *           .. end of outer loop for matrices ..
  88.             goto 1
  89.          elseif (itype.eq.TAGEND) then
  90.             write (*,*) 'slave', myid, ' ended normally'
  91.             return
  92.          else
  93.             write (*,*)
  94.      $           'slave', myid, ' received unexpected data type:', itype
  95.             return
  96.          endif
  97.       goto 2
  98. *-----
  99.       end
  100.